Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyStrh.p

Text File | 1997-03-21 | 8.1 KB | 349 lines | [TEXT/CWIE]

unit MyStrH;

interface

    uses
        Types,
        MyAssertions;

    type
        lineIndex = integer;

    const
        first_strh_offset = SizeOf(lineIndex);

    type
        indexPtr = ^lineIndex;
        StrHHandle = ^indexPtr;

{$ifc not do_debug}
{$definec AssertValidStrH(data)}
{$elsec}
{$definec AssertValidStrH(data) AssertValidStrHCode(data)}
{$endc}

    procedure AssertValidStrHCode( data: StrHHandle );

    function ValidStringH ( data: StrHHandle ): boolean;

    function NewStrH: StrHHandle;
    function MNewStrH( var sh: StrHHandle): OSErr;
    function MGetStrH ( resfile: integer; id: integer; var data: StrHHandle ): OSErr;

    procedure MDisposeStrH ( var data: StrHHandle );
    procedure ReleaseStrH ( data: StrHHandle );

    procedure ResetStrH ( data: StrHHandle );
    function CountStrH ( data: StrHHandle ): integer;

    function CountStrs ( id: integer ): lineIndex;
    function GetIndStr ( id: integer; index: lineIndex ): Str255;

    function GetIndStrH ( data: StrHHandle; index: lineIndex ): Str255;
    function GetNextStrH ( data: StrHHandle; var offset: longint ): Str255;
    function SetIndStrH ( data: StrHHandle; index: lineIndex; const s: Str255 ): OSErr;
    function AppendStrH ( data: StrHHandle; const s: Str255 ): OSErr;
    procedure DelIndStrH ( data: StrHHandle; index: integer );
    function InsIndStrH ( data: StrHHandle; index: integer; const s: Str255 ): OSErr;

implementation

    uses
        Memory, Resources, ToolUtils, TextUtils,
        MyMemory, MyAssertions, MyResources, MyLowLevel;

    procedure AssertValidStrHCode( data: StrHHandle );
    begin
        if CheckHandle( Handle(data) ) then begin
            Assert( ValidStringH( data ) );
        end;
    end;

    function NewStrH: StrHHandle;
    begin
        NewStrH := StrHHandle(NewHandleClear(SizeOf(lineIndex)));
    end;

    function MNewStrH( var sh: StrHHandle): OSErr;
    begin
        sh := StrHHandle(NewHandleClear(SizeOf(lineIndex)));
        MNewStrH := MemError;
    end;

    function MGetStrH ( resfile: integer; id: integer; var data: StrHHandle ): OSErr;
        var
            err: OSErr;
    begin
        err := MGetResource( resfile,  'STR#', id, data );
        if err = noErr then begin
            HNoPurge( Handle(data) );
            AssertValidStrH( data );
        end;
        MGetStrH := err;
    end;

    procedure MDisposeStrH ( var data: StrHHandle );
    begin
        if data <> nil then begin
            AssertValidStrH( data );
            MDisposeHandle( data );
        end;
    end;

    procedure ReleaseStrH ( data: StrHHandle );
    begin
        AssertValidStrH( data );
        ReleaseResource( Handle(data) );
    end;

    procedure ResetStrH ( data: StrHHandle );
    begin
        AssertValidStrH( data );
        MShrinkHandleSize( data, SizeOf(lineIndex) );
        data^^ := 0;
        AssertValidStrH( data );
    end;

    function CountStrH ( data: StrHHandle ): integer;
    begin
        AssertValidStrH( data );
        CountStrH := data^^;
    end;

    function CountStrs ( id: integer ): lineIndex;
        var
            data: StrHHandle;
    begin
        data := StrHHandle( GetResource( 'STR#', id )) ;
        AssertValidStrH( data );
        if data <> nil then begin
            CountStrs := data^^;
        end else begin
            CountStrs := 0;
        end;
    end;

    function GetIndStr ( id: integer; index: lineIndex ): Str255;
        var
            s: Str255;
    begin
        Assert( index > 0 );
        GetIndString( s, id, index );
        GetIndStr := s;
    end;

    function ValidStringH ( data: StrHHandle ): boolean;
        var
            count, i: lineIndex;
            ps: longint;
            size: longint;
    begin
        ValidStringH := false;
        if (data <> nil) then begin
            size := MGetHandleSize( Handle(data) );
            if (size >= SizeOf(lineIndex)) & (MemError = noErr) then begin
                count := data^^;
                ps := SizeOf(lineIndex);
                for i := 1 to count do begin
                    ps := ps + GetUnsignedByte( data^, ps ) + 1;
                    if ps > size then begin
                        leave;
                    end;
                end;
                ValidStringH := size = ps;
            end;
        end;
    end;

    function StrHIndexToOffset( data: StrHHandle; index: lineIndex ): longint;
        var
            count, i: lineIndex;
            ps: longint;
    begin
        AssertValidStrH( data );
        Assert( index > 0 );
        count := data^^;
        if (1 <= index) and (index <= count) then begin
            ps := SizeOf(lineIndex);
            for i := 1 to index - 1 do begin
                ps := ps + GetUnsignedByte( data^, ps ) + 1;
            end;
        end else begin
            ps := MGetHandleSize(Handle(data));
        end;
        StrHIndexToOffset := ps;
        AssertValidStrH( data );
    end;

    function GetIndStrH ( data: StrHHandle; index: lineIndex ): Str255;
        var
            s: Str255;
            ps: longint;
    begin
        AssertValidStrH( data );
        Assert( index > 0 );
        ps := StrHIndexToOffset( data, index );
        if ps < MGetHandleSize( Handle(data) ) then begin
            BlockMoveData( AddPtrLong( data^, ps ), @s, GetUnsignedByte( data^, ps ) + 1);
        end else begin
            s := '';
        end;
        GetIndStrH := s;
        AssertValidStrH( data );
    end;

    function GetNextStrH ( data: StrHHandle; var offset: longint ): Str255;
        var
            s: Str255;
            len: integer;
    begin
        AssertValidStrH( data );
        if offset >= MGetHandleSize( Handle(data) ) then begin
            s := '';
        end else begin
            len := GetUnsignedByte( data^, offset ) + 1;
            BlockMoveData( AddPtrLong( data^, offset ), @s, len );
            offset := offset + len;
        end;
        GetNextStrH := s;
        AssertValidStrH( data );
    end;

    function SetIndStrH ( data: StrHHandle; index: lineIndex; const s: Str255 ): OSErr;
        var
            err: OSErr;
            count: lineIndex;
            size: longint;
            pos: longint;
            ps: longint;
    begin
        AssertValidStrH( data );
        Assert( index > 0 );
        err := noErr;
        count := data^^;
        size := MGetHandleSize( Handle(data) );
        if count < index then begin
            err := MGrowHandleSize( Handle(data), size + index - count );
            if err = noErr then begin
                MZero( AddPtrLong( data^, size ), index - count );
                ps := size + index - count - 1;
                data^^ := index;
                count := index;
            end;
        end else begin
            ps := StrHIndexToOffset( data, index );
        end;
        if err = noErr then begin
            pos := Munger( Handle(data), ps, nil, GetUnsignedByte( data^, ps ) + 1, @s, length(s) + 1 );
            err := MemError;
        end;
        SetIndStrH := err;
        AssertValidStrH( data );
    end;

    function AppendStrH ( data: StrHHandle; const s: Str255 ): OSErr;
        var
            err: OSErr;
    begin
        AssertValidStrH( data );
        err := PtrAndHand( @s, Handle(data), length(s) + 1);
        if err = noErr then begin
            Inc(data^^);
        end;
        AppendStrH := err;
        AssertValidStrH( data );
    end;

    procedure DelIndStrH ( data: StrHHandle; index: integer );
        var
            count: lineIndex;
            size: longint;
            ps: longint;
    begin
        AssertValidStrH( data );
        Assert( index > 0 );
        count := data^^;
        size := MGetHandleSize( Handle(data) );
        if index <= count then begin
            ps := StrHIndexToOffset( data, index );
            MMungerDelete( Handle(data), ps, GetUnsignedByte( data^, ps ) + 1 );
            data^^ := count - 1;
        end;
        AssertValidStrH( data );
    end;

    function InsIndStrH ( data: StrHHandle; index: integer; const s: Str255 ): OSErr;
        var
            err: OSErr;
            count: lineIndex;
            ps: longint;
            t: string[2];
    begin
        err := noErr;
        AssertValidStrH( data );
        Assert( index > 0 );
        count := data^^;
        if index <= count then begin
            ps := StrHIndexToOffset( data, index );
            t := '';
            err := MMungerInsert( Handle(data), ps, @t, length(t) + 1 );
            if err = noErr then begin
                data^^ := count + 1;
            end;
        end;
        if err = noErr then begin
            err := SetIndStrH(data, index, s);
        end;
        InsIndStrH := err;
        AssertValidStrH( data );
    end;

end.
    procedure DisposeStrH ( data: StrHHandle );
    begin
        if data <> nil then begin
            AssertValidStrH( data );
            MDisposeHandle( data );
        end;
    end;

    procedure SetIndStr (id, index: lineIndex; const s: Str255);
        var
            data: StrHHandle;
    begin
        data := StrHHandle( GetResource('STR#', id) );
        AssertValidStrH( data );
        HNoPurge(Handle(data));
        SetIndStrH(data, index, s);
        HPurge(Handle(data));
        ChangedResource(Handle(data));
        WriteResource(Handle(data));
    end;

    procedure DelIndStr (id: integer; index: lineIndex);
        var
            data: StrHHandle;
    begin
        data := StrHHandle(GetResource('STR#', id));
        Assert( data <> nil );
        HNoPurge(Handle(data));
        DelIndStrH(data, index);
        HPurge(Handle(data));
        ChangedResource(Handle(data));
        WriteResource(Handle(data));
    end;

    procedure InsIndString (id: integer; index: lineIndex; const s: Str255);
        var
            data: StrHHandle;
    begin
        data := StrHHandle(GetResource('STR#', id));
        Assert( data <> nil );
        HNoPurge(Handle(data));
        InsIndStrH(data, index, s);
        HPurge(Handle(data));
        ChangedResource(Handle(data));
        WriteResource(Handle(data));
    end;